home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1996 / MacHack 1996.toast / Hacks / Hacks ’90 / DataStack Filer / StackFiles.Mod < prev   
Encoding:
Modula Implementation  |  1995-09-10  |  5.8 KB  |  233 lines  |  [TEXT/MPS ]
  1. IMPLEMENTATION MODULE StackFiles;
  2. (*    Copyright:    © 1990 by Keith Nemitz, all rights reserved. *)
  3. FROM SYSTEM IMPORT ADR,ADDRESS;
  4.  
  5. FROM Strings IMPORT Assign,Concat,MakePascalString;
  6.  
  7. FROM MacTypes IMPORT OSType,OSErr,Str255;
  8. FROM MemoryManager IMPORT NewHandle,DisposHandle,noErr,MemError;
  9. FROM FileManager IMPORT HCreate,HOpen,FSClose,HDelete,
  10.         Allocate,HRENAME,fsRdPerm,fsWrPerm; (* HRename *)
  11.  
  12. FROM DataStacks IMPORT NewDataStack,DisposeDataStack,LoadDataStack,
  13.         DataStack,DumpDataStack,dataStackErr;
  14.  
  15.  
  16. TYPE
  17.     StackFile = POINTER TO StackFilePtr;
  18.     StackFilePtr = POINTER TO StackFileRec;
  19.     StackFileRec = RECORD
  20.                             fName :ARRAY [1..32] OF CHAR;
  21.                             vid :INTEGER;
  22.                             pid :LONGINT;
  23.                             stack :DataStack;
  24.                             END;
  25.  
  26.  
  27. PROCEDURE HRename(vRefNum:INTEGER; dirID:LONGINT; oldName:ARRAY OF CHAR;
  28.                                                                     newName:ARRAY OF CHAR):OSErr;
  29. VAR s1,s2 :Str255;
  30. BEGIN
  31.     MakePascalString(oldName,s1);
  32.     MakePascalString(newName,s2);
  33.     RETURN HRENAME(vRefNum,dirID,s1,s2); 
  34.     END HRename;
  35.  
  36.  
  37. PROCEDURE NewStackFile(name:ARRAY OF CHAR; volID:INTEGER; dirID:LONGINT;
  38.                                 
  39.                                 cSize:LONGINT; initial,grow:CARDINAL):StackFile;
  40. VAR
  41.     tmpStack :DataStack;
  42.     stkFile :StackFile;
  43. BEGIN
  44.     dataStackErr := noErr;
  45.     stkFile := NewHandle(SIZE(StackFileRec));
  46.     IF stkFile = NIL THEN
  47.         dataStackErr := MemError();
  48.         RETURN NIL;
  49.         END;
  50.     
  51.     tmpStack := NewDataStack(cSize,initial,grow);
  52.     IF VAL(ADDRESS,tmpStack) = NIL THEN
  53.         DisposHandle(stkFile);
  54.         RETURN NIL; 
  55.         END;
  56.  
  57.     WITH stkFile^^ DO
  58.         vid := volID;
  59.         pid := dirID;
  60.         stack := tmpStack;
  61.         Assign(name,fName);
  62.         END;(*with*)
  63.         
  64.     RETURN stkFile;
  65.     END NewStackFile;
  66.  
  67. PROCEDURE GetStackFile(name:ARRAY OF CHAR; volID:INTEGER; dirID:LONGINT):StackFile;
  68. VAR
  69.     err :OSErr;
  70.     refNum :INTEGER;
  71.     stkFile :StackFile;
  72.     tmpStack :DataStack;
  73. BEGIN
  74.     dataStackErr := HOpen(volID,dirID,name,ORD(fsRdPerm),refNum);
  75.     IF dataStackErr # 0 THEN RETURN NIL; END;
  76.     
  77.     tmpStack := LoadDataStack(refNum);
  78.     err := FSClose(refNum); (* what to do if close should fail??? *)
  79.     IF VAL(ADDRESS,tmpStack) = NIL THEN RETURN NIL; END;
  80.     
  81.     stkFile := NewHandle(SIZE(StackFileRec));
  82.     IF stkFile = NIL THEN
  83.         dataStackErr := MemError();
  84.         RETURN NIL;
  85.         END;
  86.     
  87.     WITH stkFile^^ DO
  88.         vid := volID;
  89.         pid := dirID;
  90.         stack := tmpStack;
  91.         Assign(name,fName);
  92.         END;(*with*)
  93.     
  94.     RETURN stkFile;
  95.     END GetStackFile;
  96.  
  97.  
  98. PROCEDURE SaveStackFile(sFile:StackFile);
  99. VAR
  100.     err :OSErr;
  101.     count :LONGINT;
  102.     refNum :INTEGER;
  103.     str1,str2 :Str255;
  104.     stkFRec :StackFileRec;
  105. BEGIN
  106.     dataStackErr := noErr;
  107.  
  108.     (* free space on disk is verified in DumpStack. It will return 
  109.         and propagate the allocation error message if DumpStack could not
  110.         find enough free space for current volume. *)
  111.     
  112.     stkFRec := sFile^^;
  113.     WITH stkFRec DO
  114.         Concat(fName,".saved",str1);
  115.         Concat(fName,".temp",str2);
  116.         
  117.         err := HRename(vid,pid,str1,str2); (* rename saved to temp. *)
  118.         IF NOT ((err = 0) OR (err = -37) OR (err = -43)) THEN
  119.             dataStackErr := err;
  120.             RETURN;
  121.             END;
  122.         err := HRename(vid,pid,fName,str1); (* rename file to saved. *)
  123.         IF NOT ((err = 0) OR (err = -37) OR (err = -43)) THEN
  124.             dataStackErr := err;
  125.             RETURN;
  126.             END;
  127.         
  128.         dataStackErr := HCreate(vid,pid,fName,'????','DECK');
  129.         IF dataStackErr # 0 THEN
  130.             err := HRename(vid,pid,str1,fName); (* rename saved back to file. *)
  131.             err := HRename(vid,pid,str2,str1); (* rename temp back to saved. *)
  132.             RETURN;
  133.             END;
  134.         
  135.         dataStackErr := HOpen(vid,pid,fName,ORD(fsWrPerm),refNum);
  136.         IF dataStackErr # 0 THEN
  137.             err := HRename(vid,pid,str1,fName); (* rename saved back to file. *)
  138.             err := HRename(vid,pid,str2,str1); (* rename temp back to saved. *)
  139.             RETURN;
  140.             END;
  141.         
  142.         IF DumpDataStack(stack,refNum) THEN
  143.             err := FSClose(refNum);
  144.             err := HDelete(vid,pid,str2); (* delete temp file *)
  145.             RETURN;
  146.         ELSE
  147.             err := FSClose(refNum);
  148.             err := HDelete(vid,pid,fName); (* delete attempted file. *)
  149.             err := HRename(vid,pid,str1,fName); (* rename saved back to file. *)
  150.             err := HRename(vid,pid,str2,str1); (* rename temp back to saved. *)
  151.             RETURN;
  152.             END;
  153.         END;(*with*)
  154.     END SaveStackFile;
  155.  
  156. PROCEDURE CloseStackFile(sFile:StackFile);
  157. BEGIN
  158.     DisposeDataStack(sFile^^.stack);
  159.     DisposHandle(sFile);
  160.     END CloseStackFile;
  161.  
  162.  
  163. PROCEDURE GetDataStack(sFile:StackFile):DataStack;
  164. BEGIN
  165.     RETURN VAL(ADDRESS,sFile^^.stack);
  166.     END GetDataStack;
  167.  
  168.  
  169. END StackFiles.
  170.  
  171.  
  172.  
  173.  
  174. (*
  175.     dataStackErr := noErr;
  176.  
  177.     (* free space on disk is verified in DumpStack. It will return 
  178.         and propagate the allocation error message if DumpStack could not
  179.         find enough free space for current volume. *)
  180.     
  181.     stkFRec := sFile^^;
  182.     WITH stkFRec DO
  183.         IF NOT save THEN
  184.             DisposeDataStack(stack);
  185.             DisposHandle(sFile);
  186.             RETURN;
  187.             END;
  188.     
  189.         Concat(fName,".saved",str1);
  190.         Concat(fName,".temp",str2);
  191.         
  192.         err := HRename(vid,pid,str1,str2); (* rename saved to temp. *)
  193.         IF NOT ((err = 0) OR (err = -37) OR (err = -43)) THEN
  194.             dataStackErr := err;
  195.             RETURN;
  196.             END;
  197.         err := HRename(vid,pid,fName,str1); (* rename file to saved. *)
  198.         IF NOT ((err = 0) OR (err = -37) OR (err = -43)) THEN
  199.             dataStackErr := err;
  200.             RETURN;
  201.             END;
  202.         
  203.         dataStackErr := HCreate(vid,pid,fName,'????','DECK');
  204.         IF dataStackErr # 0 THEN
  205.             err := HRename(vid,pid,str1,fName); (* rename saved back to file. *)
  206.             err := HRename(vid,pid,str2,str1); (* rename temp back to saved. *)
  207.             RETURN;
  208.             END;
  209.         
  210.         dataStackErr := HOpen(vid,pid,fName,ORD(fsWrPerm),refNum);
  211.         IF dataStackErr # 0 THEN
  212.             err := HRename(vid,pid,str1,fName); (* rename saved back to file. *)
  213.             err := HRename(vid,pid,str2,str1); (* rename temp back to saved. *)
  214.             RETURN;
  215.             END;
  216.         
  217.         IF DumpDataStack(stack,refNum) THEN
  218.             err := FSClose(refNum);
  219.             err := HDelete(vid,pid,str2); (* delete temp file *)
  220.             DisposeDataStack(stack);
  221.             DisposHandle(sFile);
  222.             RETURN;
  223.         ELSE
  224.             err := FSClose(refNum);
  225.             err := HDelete(vid,pid,fName); (* delete attempted file. *)
  226.             err := HRename(vid,pid,str1,fName); (* rename saved back to file. *)
  227.             err := HRename(vid,pid,str2,str1); (* rename temp back to saved. *)
  228.             RETURN;
  229.             END;
  230.         END;(*with*)
  231. *)
  232.  
  233.